package clnet;

#########################################################################
# This module provides the higher level functionality for many aspects	#
# of dealing with network cards. It now has been modified to cater for	#
# IPv4 by default, with optios for IPv6 ip details when addresses	#
# are prefixied with 6| or IP6|.					#
# Simon - 06th October 2011						#
#########################################################################

use strict;
use Data::Dumper;
use Sys::Hostname;
use Net::Ping;
use ipinterfaces;
use ping6;

BEGIN {
	use Exporter ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

	$VERSION=0.1;
	@ISA	= qw(Exporter);
	@EXPORT_OK = qw(
		&_CLNET_get_card_list2
		&CLNET_check_ping_list2
		&CLNET_check_cards_exist2
		&CLNET_check_networks2
		&CLNET_check_one_ip2
		&CLNET_get_network_list2
		&CLNET_return_static_ips2
		&CLNET_return_network_static_ip2
		&CLNET_assign_network_ips2
		&CLNET_unassign_network_ips2
		&CLNET_assign_ips2
		&CLNET_unassign_ips2
		&CLNET_check_ping2
		&CLNET_migrate_ips2
		&CLNET_map_ip_to_network2
		&CLNET_check_cards_unique2
		&CLNET_get_network_attributes2
		&_gen_ip_list
		&_gen_ip6_list
	);
	@EXPORT = ();
	%EXPORT_TAGS = ( ALL => [@EXPORT_OK] );
}
our @EXPORT_OK;

eval { require "miitoollib.pm"; } ;

sub _CLNET_get_card_list2 {
my %args=@_;
my ($cards,$xml);

	if(!exists($args{network}) || !exists($args{node}) || !exists($args{xml})) {
		return(0,"Missing mandatory argument.");
	}
	$xml=$args{xml};
	if(!exists($xml->{node}->{$args{node}})) {
		return(0,"Missing node details for node ".$args{node});
	}
	if(!exists($xml->{node}->{$args{node}}->{network})) {
		return(0,"Missing node network details for node ".$args{node});
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
		if($args{network} ne $xml->{node}->{$args{node}}->{network}->{name}) {
			return(0,"Unknown network ".$args{network}." on node ".$args{node});
		}
		if(!exists($xml->{node}->{$args{node}}->{network}->{cards})) {
			return(0,"Missing cards element for network ".$args{network}." on node ".$args{node});
		}
		$cards=$xml->{node}->{$args{node}}->{network}->{cards};
	} else {
		if(!exists($xml->{node}->{$args{node}}->{network}->{$args{network}})) {
			return(0,"Unknown network ".$args{network}." on node ".$args{node});
		}
		if(!exists($xml->{node}->{$args{node}}->{network}->{$args{network}}->{cards})) {
			return(0,"Missing cards element for network ".$args{network}." on node ".$args{node});
		}
		$cards=$xml->{node}->{$args{node}}->{network}->{$args{network}}->{cards};
	}

	#################################################################
	# At this point the cards variable holds the list of cards for	#
	# this network, so return them...				#
	#################################################################
	return(1,$cards);
}

#########################################################################
# CLNET_check_one_ip2([node=>"node"],network=>"X",XML=>"z")		#
# This will return whether the specified node on the specified		#
# network has one and only one IP address on a physical card. It will	#
# returns (1,$card_4,$card_6,$ip_4,$ip_6) - if exactly 1 found.		#
#         (0,err,...) otherwise						#
# It takes account of the xml->global->iptype setting or either 4,6	#
# or both and will return error if any of the expected addresses are	#
# actually missing.							#
#########################################################################

sub CLNET_check_one_ip2 {
my %args=@_;
my ($res,$cards);
my ($ipinters,@ints);
my (%found_cards,$acard_4,$aip_4,$acard_6,$aip_6);
my @errs=();

	if(!exists($args{node})) {
		$args{node}=hostname;
	}
	($res,$cards)=_CLNET_get_card_list2(%args);
	if(!$res) {
		return($res,$cards);
	}

	#################################################################
	# Cards is the comma separated list of cards, so check that	#
	# one and only one has a IP address...				#
	#################################################################
	
	if($args{node} ne hostname) {
		$ipinters=ipinterfaces->new(remote => $args{node});
	} else {
		$ipinters=ipinterfaces->new;
	}
	$ipinters->scan_interfaces;
	@ints=$ipinters->list(physical=>1);

	#################################################################
	# We must emsure that if more than one card is listed, only	#
	# one has an {ip} element...					#
	#################################################################
	%found_cards=();
	for my $card (split(/,/,$cards)) {
		my $cinter;
		if(scalar(grep {/^$card$/} @ints)) {
			$cinter=$ipinters->get_details2(interface=>"$card:0");
			if(defined($cinter)) {
				for my $cc (@{$cinter->{ip4}}) {
					if(@$cc>1) {
						$acard_4=$card;
						$aip_4=$cc->[0];
						$found_cards{$cinter}=1;
						push @errs,"Found IPv4 address $aip_4 on interface $acard_4.";
					}
				}
				for my $cc (@{$cinter->{ip6}}) {
					if(@$cc>1) {
						$acard_6=$card;
						$aip_6=$cc->[0];
						$found_cards{$cinter}=1;
						push @errs,"Found IPv6 address $aip_6 on interface $acard_6.";
					}
				}
			}
		}
	}
	return(0,@errs) if scalar(keys(%found_cards))>1;
	return(0,"No IP addresses found!") if scalar(keys(%found_cards))==0;
	my $tt='4';
	if(exists($args{xml}->{global}->{iptype})) {
		$tt=$args{xml}->{global}->{iptype};
	}
	if($tt eq '4' && !defined($aip_4)) {
		return(0,'No IPv4 address found.');
	}
	if($tt eq '6' && !defined($aip_6)) {
		return(0,'No IPv6 address found.');
	}
	if($tt eq 'both' && (!defined($aip_6) || !defined($aip_4))) {
		return(0,'No IPv6/IPv4 pair found on interface.');
	}
	return(1,$acard_4,$acard_6,$aip_4,$aip_6);
}

#########################################################################
# check_cards_exist(network=>"X",node=>"y",XML=>"z")			#
# Returns list of two references to arrays - first one containing	#
# cards that do exist, the 2nd containing the cards that do not		#
# exist.								#
#########################################################################

sub CLNET_check_cards_exist2 {
my %args=@_;
my ($res,$cards);
my ($ipinters,@ints);
my (@found,@nfound);

	($res,$cards)=_CLNET_get_card_list2(@_);
	if(!$res) {
		return(undef,undef);
	}
	$ipinters=ipinterfaces->new;
	@ints=$ipinters->list(physical=>1,all=>1);
	@found=();
	@nfound=();
	for my $card (split(/,/,$cards)) {
		my $cinter;
		if(scalar(grep {/^$card$/} @ints)) {
			push @found,$card;
		} else {
			push @nfound,$card;
		}
	}
	return(\@found,\@nfound);
}

#########################################################################
# This will return (attributes,error) for the speccified network on	#
# the specified host.							#
# If no attributes are defined will return (undef,undef) - or if an	#
# error occurs will return (undef,error).				#
#########################################################################

sub CLNET_get_network_attributes2 {
my %args=@_;
my $xml;

	if(!exists($args{network}) || !exists($args{node}) || 
		!exists($args{xml})) {
		return(undef,"Missing mandatory argument.");
	}
	$xml=$args{xml};
	if(!exists($xml->{node}->{$args{node}})) {
		return(undef,"Missing node details for node ".$args{node});
	}
	if(!exists($xml->{node}->{$args{node}}->{network})) {
		return(0,"Missing node network details for node ".$args{node});
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
		if($xml->{node}->{$args{node}}->{network}->{name} ne $args{network}) {
			return(undef,"No such network defined.");
		}
		if(exists($xml->{node}->{$args{node}}->{network}->{attributes})) {
			return($xml->{node}->{$args{node}}->{network}->{attributes},undef);
		}
		return(undef,undef);
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{$args{network}})) {
		if(exists($xml->{node}->{$args{node}}->{network}->{$args{network}}->{attributes})) {
			return($xml->{node}->{$args{node}}->{network}->{$args{network}}->{attributes},undef);
		}
		return(undef,undef);
	}
	return(undef,"No such network defined.");
}

#########################################################################
# get_network_list(node=>"y",xml=>"z")					#
# Returns a list of network names that have been defined in the		#
# XML file for the node in question. Results is (1|0,a,b,c...)		#
# If 0 (error), then a == error message.				#
#########################################################################

sub CLNET_get_network_list2 {
my %args=@_;
my $xml;

	if(!exists($args{node}) || !exists($args{xml})) {
		return(0,"Missing mandatory argument.");
	}
	$xml=$args{xml};
	if(!exists($xml->{node}->{$args{node}})) {
		return(0,"Missing node details for node ".$args{node});
	}
	if(!exists($xml->{node}->{$args{node}}->{network})) {
		return(0,"Missing node network details for node ".$args{node});
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
		return(1,$xml->{node}->{$args{node}}->{network}->{name});
	}
	return(1,sort(keys(%{$xml->{node}->{$args{node}}->{network}})));
}

sub CLNET_check_cards_unique2 {
my %args=@_;
my $xml;
my ($res,@nets);

	$xml=$args{xml};
	($res,@nets)=CLNET_get_network_list2(%args);
	return($res,@nets) if $res==0;

	my %cards=();
	my $cnet;
	my @F; my @errs=();
	for $cnet (@nets) {
		if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
			@F=split(/,/,$xml->{node}->{$args{node}}->{network}->{cards});
		} else {
			@F=split(/,/,$xml->{node}->{$args{node}}->{network}->{$cnet}->{cards});
		}
		for (@F) {
			if(exists($cards{$_})) {
				push @errs,"Card $_ in $cnet already defined for network $cards{$_}.";
			} else {
				$cards{$_}=$cnet;
			}
		}
	}
	return(1) if !@errs;
	return(0,@errs);
}

#########################################################################
# check_netmasks (xml=>xml,[node=>remotenodename])			#
# This will check to ensure that every interface with an IP address	#
# on the specified node (just looking at physical interfaces) is	#
# on a separate network.						#
# Returns (1) or (0,"err",..)						#
# Uses the xml->global->iptype setting of '4'/'6' or 'both' (default is	#
# '4') to ascertain which type of IP addresses we should be checking.	#
#########################################################################

sub CLNET_check_networks2 {
my %args=@_;
my (%nets,$ipinters,@ints,@errs,@ok);

	my $tt='4';
	if(exists($args{xml}->{global}->{iptype})) {
		$tt=$args{xml}->{global}->{iptype};
	}
	%nets=();
	@errs=();
	@ok=();
	if(exists($args{node}) && $args{node} ne hostname) {
		$ipinters=ipinterfaces->new(remote => $args{node});
	} else {
		$ipinters=ipinterfaces->new;
	}
	$ipinters->scan_interfaces;
	@ints=$ipinters->list(physical=>1);
	for my $cint (@ints) {
		my $ref;

		$ref=$ipinters->get_details2(interface=>"$cint:0");
		if(defined($ref) && ($tt eq '4' || $tt eq 'both') && exists($ref->{ip4}) && @{$ref->{ip4}}) {
			if(!exists($nets{$ref->{ip4}->[0]->[3]})) {
				$nets{$ref->{ip4}->[0]->[3]}=[];
			}
			push @{$nets{$ref->{ip4}->[0]->[3]}},$cint;
		}
		if(defined($ref) && ($tt eq '6' || $tt eq 'both') && exists($ref->{ip6}) && @{$ref->{ip6}}) {
			if(!exists($nets{$ref->{ip6}->[0]->[3]})) {
				$nets{$ref->{ip6}->[0]->[3]}=[];
			}
			push @{$nets{$ref->{ip6}->[0]->[3]}},$cint;
		}
	}
	for (sort(keys(%nets))) {
		if(scalar(@{$nets{$_}})>1) {
			push @errs,"Cards ".join(",",@{$nets{$_}})." share network $_";
		} else {
			push @ok,"Interface ".${$nets{$_}}[0]." is on network $_";
		}
	}
	if($#errs==-1) {
		return(1,@ok);
	}
	return(0,@errs);
}

#########################################################################
# This will return the IP associated with the remote node - does so	#
# by reading the local /etc/cluster/.networks file if it exists and	#
# returns them as a list of IP addresses.				#
# If it finds ipv6 ip addersses these are in [] brackets...		#
#########################################################################

sub CLNET_return_static_ips2 {
my %args=@_;
my ($fd,$cline,@ips,@F);

	return() if !exists($args{node});
	@ips=();
	if(! -f "/etc/cluster/.networks") {
		return ();
	}
	open($fd,"/etc/cluster/.networks");
	while($cline=<$fd>) {
		chomp $cline;
		if(substr($cline,0,2) eq '4:') {
			@F=split(/:/,substr($cline,2));
			next if $F[0] ne $args{node};
			push @ips,$F[2];
		} else {
			my ($_ip,$host,$net,$ip);
			($_ip,$host,$net,$ip)=($cline =~ /^(\d+):(.*?):(.*?):(.*)/);
			next if $host ne $args{node};
			push @ips,$ip;
		}
	}
	close($fd);
	return (@ips);
}

# Retrun the static ip of a network, preferring ipv6 if available.

sub CLNET_return_network_static_ip2 {
my %args=@_;
my ($fd,$cline,$ip,@F);

	return undef if !exists($args{node});
	return undef if !exists($args{network});
	return undef if !exists($args{xml});
	if(! -f "/etc/cluster/.networks") {
		return undef;
	}
	my $type='4';
	if(exists($args{xml}->{global}->{iptype})) {
		$type=$args{xml}->{global}->{iptype};
	}

	my $ipv4=undef; my $ipv6=undef;
	open($fd,"/etc/cluster/.networks");
	while($cline=<$fd>) {
		chomp $cline;
		if(substr($cline,0,2) eq '4:' && ! $ipv4) {
			@F=split(/:/,substr($cline,2));
			next if $F[0] ne $args{node};
			next if $F[1] ne $args{network};
			$ipv4=$F[2]; next;
		}
		if(substr($cline,0,2) eq '6:' && !$ipv6) {
			my ($_ip,$host,$net);
			($_ip,$host,$net,$ip)=($cline =~ /^(\d+):(.*?):(.*?):(.*)/);
			next if $host ne $args{node};
			next if $net ne $args{network};
			$ip =~ s/^\[//;
			$ip =~ s/\]$//;
			$ipv6=$ip; next;
		}
	}
	close($fd);
	if($type eq '4' && $ipv4) {
		return $ipv4;
	}
	if($type eq '4' && $ipv6) {
		return undef;
	}
	if( ($type eq 'both' || $type eq '6') && $ipv6) {
		return $ipv6;
	}
	if($ipv4) {
		return $ipv4;
	}
	print "yuck (type=$type)!\n";
	return undef;
}

#########################################################################
# assign_ips(xml="x",appxml=>"y",network="z")				#
# Will assign all IP addresses (ignoring if already assigned) for the	#
# specified application and network on the local host. Will return	#
# (1) - ok or (0,err,...) if error.					#
# Note: It is the responsibility of the call to get a lock on the	#
# 	NET resource before making use of this routine.			#
#	The code here is based on the similar code found in the		#
#	ipinterfaces module (that code will be removed).		#
#									#
# 1.1.x series changes							#
# An optional rebuild=>1 can be sent if a IP addressing rebuild for	#
# the network in question is considered. Normally the IP addresses	#
# associated with the application are simply set based on the config	#
# with any existing /etc/cluster/.resoures/ips/app-net-IP files being	#
# deleted first.							#
#									#
# When rebuild=>1 is set then the files are left in place, and a first	#
# run through checks files against IP's for the application. If any	#
# files are found for no IP's then the IP in question is dropped.	#
#									#
# At that point the offending file is removed and then the process of	#
# adding IP's as normal is performed.					#
#########################################################################

sub _bits_to_mask($) {
my $b=$_[0];

	if($b =~ /\./) { return $b};

	my $mask=0xFFFFFFFF - ((1<<32-$b)-1);
	my @v=();
	for(0..3) {
		unshift @v,$mask&0xff;
		$mask=$mask>>8;
	}
	return join(".",@v);
}

sub _gen_ip6_list($) {
my $ips=$_[0];
my %netmasks=();

	#########################################################
	# Cater for the special occurance of when a network 	#
	# consists of MONITOR...				#
	#########################################################
	if(uc($ips) eq "MONITOR") {
		return ("",{});
	}

	my $first="";
	my @x=split(/,/,$ips);
	$ips="";
	my @I=();
	for(@x) {
		my ($cip,$cnetmask)=(/^([0-9a-f:]+)\/(\d+)$/);
		if(!defined($cip) || !defined($cnetmask)) {
			return(undef,{});
		}
		push @I,$_;
		$netmasks{$_}=$cnetmask;
	}
	$ips=join(',',@I);
	return ($ips,{%netmasks});
}

sub _gen_ip_list($) {
my $ips=$_[0];
my %netmasks=();

	#########################################################
	# Cater for the special occurance of when a network 	#
	# consists of MONITOR...				#
	#########################################################
	if(uc($ips) eq "MONITOR") {
		return ("",{});
	}

	my $first="";
	my @x=split(/,/,$ips);
	$ips="";
	for(@x) {
		my $m=undef;
		if(/\/(.*)/) {
			$m=_bits_to_mask($1);
			s/\/.*//;
		}
		my ($a,$b,$c,$d,@j)=split(/\./,$_);
		if(defined($a) && defined($b) && defined($c)) {
			$first="$a.$b.$c";
		}
		if(/(\d+)\-(\d+)$/) {
			my ($l1,$l2)=($1,$2);
			while($l1<=$l2) {
				$netmasks{"$first.$l1"}=$m if defined($m);
				$ips.=",$first.$l1";
				$l1++;
			}	
		} elsif(/^(\d+\.){1,}/) {
			$netmasks{$_}=$m if defined($m);
			$ips.=",$_";
		# } elsif(!defined($b)) {
		} else {
			$netmasks{"$first.$_"}=$m if defined($m);
			$ips.=",$first.$_";
		}
	}
	$ips=~s/^,//;
	return ($ips,{%netmasks});
}

sub CLNET_assign_network_ips2 {
my %args=@_;
my ($rc,@errs,$card,@nets);
my ($xml,$net,$f,$appxml,$ref,$chashref,$listref);
my ($ips,$cip,$ipinters,$cint);
my $use_miitoollib;
my $rebuild=0;
my $netm;

	if(!exists($args{xml}) || !exists($args{appxml}) || !exists($args{network})) {
		return(0,"Missing one or more mandatory arguments (xml,appxml or network).");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};
	my $appname=$appxml->{global}->{name};
	$net=$args{network};

	if(exists($args{rebuild}) && defined($args{rebuild}) &&
		$args{rebuild}) {
		$rebuild=1;
	}

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# We now need to scan the list of networks looking for the one	#
	# that needs assigning.						#
	#################################################################

	$f=0;
	for (@$listref) {
		if(exists($_->{net}) && $_->{net} eq $net) {
			$f=1; $chashref=$_; last;
		}
	}
	if(!$f) {
		return(0,"Network $net not defined for application.");
	}

	#################################################################
	# Does the IP's directory exist, and if not create it, or	#
	# carry on without it.						#
	#################################################################

	my $ipfolder=1;
	if(! -d "/etc/cluster/.resources/ips") {
		mkdir "/etc/cluster/.resources/ips" or $ipfolder=0;
	}
	if($ipfolder && !$rebuild) {
		#########################################################
		# No rebuild, so remove any existing dir entries.	#
		#########################################################
		my @D=();
		my ($dfd,$cline);
		if(opendir($dfd,"/etc/cluster/.resources/ips")) {
			@D=readdir($dfd);
			close($dfd);
		}
		for (@D) {
			if(/^$appname-$net-/) {
				unlink "/etc/cluster/.resources/ips/$_";
			}
		}			
	}

	$ipinters=ipinterfaces->new;
	#################################################################
	# If performing a rebuild we need to get a list of IP		#
	# addresses that exist as files, but are not part of the	#
	# network IP list at present, since we need to remove them!	#
	#################################################################
	my $r;
	if($rebuild && $ipfolder) {
		my @D=();
		my ($dfd,$cline);
		if(opendir($dfd,"/etc/cluster/.resources/ips")) {
			@D=grep {/^$appname-$net-/} readdir($dfd);
			close($dfd);
		}

		#########################################################
		# If the complete network has been removed then we	#
		# do not filter @D at all, otherwise we need to		#
		# filter the list.					#
		#########################################################

		$f=0;
		if(exists($appxml->{networks}) && exists($appxml->{networks}->{network})) {
			$ref=ref($appxml->{networks}->{network});
			if($ref eq "HASH") {
				$listref=[$appxml->{networks}->{network}];
			} else {
				$listref=$appxml->{networks}->{network};
			}
			for (@$listref) {
				if(exists($_->{net}) && $_->{net} eq $net) {
					$f=1; $chashref=$_; last;
				}
			}
		}

		#########################################################
		# Network still exists, so build list of IP's to	#
		# understand which ones might need to be removed.	#
		#########################################################
		if($f) {
			my ($_a,$_b);
			$ips=''; $netm={};
			if(exists($chashref->{ip})) {
				($_a,$_b)=_gen_ip_list($chashref->{ip});
				if(defined($_a)) {
					$ips=$_a;
					$netm={%{$_b}};
				}
			}
			if(exists($chashref->{ip6})) {
				($_a,$_b)=_gen_ip6_list($chashref->{ip6});
				if(defined($_a)) {
					if(length($ips)) {
						$ips.=",$_a";
						$netm={%{$netm},%{$_b}};
					} else {
						$ips=$_a;
						$netm={%{$_b}};
					}
				}
			}
			my $cip;
			my @CIPS=split(/,/,$ips);
			my @N=();
			for (@D) {
				my $x=$_;
				$x =~ s/^$appname-$net-//;
				if(!scalar(grep {/^$x$/} @CIPS)) {
					push @N,$x;
				}
			}
			@D=@N;

			#################################################
			# @N is the list of IP's to remove, so remove	#
			# the file and the IP address in question.	#
			#################################################
			for (@D) {
				my $cip=$_;
				unlink "/etc/cluster/.resources/ips/$appname-$net-$cip";

				#########################################
				# Get the interface details and remove	#
				# it - ipv4 first, then ipv6.		#
				#########################################

				if($cip !~ /:/) {
					my $cint=$ipinters->get_interface(ip=>$cip);
					next if !defined($cint);

					my $cmd="ifconfig $cint down ";
					::logmsg("Removing $cip: $cmd") if defined(&::logmsg);
					$cmd.=" 2>&1";
					$r=`$cmd`; chomp $r;
					if($?>>8 && length($r)) {
						next if $r =~ /Cannot assign requested/; # dodgy non-error
						::logwarn("Unable to unassign IP address $cip from $cint") if defined(&::logwarn);
						::logwarn("Message from ifconfig: $r") if length($r) && defined(&::logwarn);
					}
				} else {
					my $cint=$ipinters->get_interface(ip=>$cip);
					next if !defined($cint);

					my $cmd="ifconfig $cint del $cip ";
					::logmsg("Removing $cip: $cmd") if defined(&::logmsg);
					$cmd.=" 2>&1";
					$r=`$cmd`; chomp $r;
					if($?>>8 && length($r)) {
						next if $r =~ /Cannot assign requested/; # dodgy non-error
						::logwarn("Unable to unassign IP address $cip from $cint") if defined(&::logwarn);
						::logwarn("Message from ifconfig: $r") if length($r) && defined(&::logwarn);
					}
				}
			}
			#################################################
			# All IP's associated with the network that	#
			# are no longer in the config have now been	#
			# removed.					#
			#################################################
		}
	}
	$use_miitoollib=defined(&miitoollib::send_arp);
 
	#################################################################
	# Now check the net exists in the list of networks in the	#
	# cluster topology.						#
	#################################################################

	($rc,@nets)=CLNET_get_network_list2(node=>hostname,xml=>$xml);
	if(!$rc) {
		return(0,"Unable to get network list from cluster topology!");
	}

	if(!scalar(grep {/^$net$/} @nets)) {
		return(0,"Network $net not defined in cluster topology!");
	}

	#################################################################
	# Firstly we need to know which interface card we need to 	#
	# assign the addresses to...					#
	#################################################################
	($rc,@errs)=CLNET_check_one_ip2(node=>hostname,network=>$net,xml=>$xml);
	if(!$rc) {
		return(0,@errs);
	}
	$card=$errs[0];
	#################################################################
	# Now we have the ethernet card, we need to find a logical 	#
	# address that is not being used.				#
	#################################################################

	{
		my ($_a,$_b);
		$ips=''; $netm={};
		if(exists($chashref->{ip})) {
			($_a,$_b)=_gen_ip_list($chashref->{ip});
			if(defined($_a)) {
				$ips=$_a;
				$netm={%{$_b}};
			}
		}
		if(exists($chashref->{ip6})) {
			($_a,$_b)=_gen_ip6_list($chashref->{ip6});
			if(defined($_a)) {
				if(length($ips)) {
					$ips.=",$_a";
					$netm={%{$netm},%{$_b}};
				} else {
					$ips=$_a;
					$netm={%{$_b}};
				}
			}
		}
	}

	for $cip (split(/,/,$ips)) {
		next if ! length($cip);
		my $cmd;
		if($cip !~ /:/) {
			$cint=$ipinters->get_interface(ip=>$cip);
			#########################################################
			# If the IP address is already assigned then just	#
			# set the netmask - so any changes in the config	#
			# file are reflected in the actual IP details.		#
			#########################################################
			if(defined($cint)) {
				$cmd="";
				if(exists($netm->{$cip})) {
					$cmd="ifconfig $cint netmask ".$netm->{$cip};
				} elsif(exists($chashref->{netmask})) {
					$cmd="ifconfig $cint netmask $chashref->{netmask}";
				}
				if($cmd ne "") {
					::logmsg("Configuring $cip: $cmd") if defined(&::logmsg);
					$cmd.=" 2>&1";
					$r=`$cmd`; chomp $r;
					if($?>>8) {
						::logwarn("Unable to change netmask on IP address $cip!") if defined(&::logwarn);
					}
				}
				next;
			}

			#########################################################
			# Only get here if the specified IP address is not	#
			# assigned.						#
			# Now get a new interface number to assign to...	#
			#########################################################
			$cint=$ipinters->get_logical(always=>1,interface => $card);

			if($cint>0) {
				$cmd="ifconfig $card:$cint inet $cip ";
			} else {
				$cmd="ifconfig $card inet $cip ";
			}
			if(exists($netm->{$cip})) {
				$cmd.=" netmask ".$netm->{$cip};
			} else {
				$cmd.=" netmask ".$chashref->{netmask} if exists($chashref->{netmask});
			}
			$cmd.=" broadcast ".$chashref->{broadcast} if exists($chashref->{broadcast});
			::logmsg("Configuring $cip: $cmd") if defined(&::logmsg);
			$cmd.=" 2>&1";
			$r=`$cmd`; chomp $r;
			if($?>>8) {
				return(0,"Unable to assign IP address $cip to $card:$cint");
			}

			#########################################################
			# Create the IP directory listing to help future	#
			# rebuilds.						#
			#########################################################

			if($ipfolder) {
				my $fd;
				open($fd,">/etc/cluster/.resources/ips/$appname-$net-$cip");
				close($fd) if defined($fd);
			}

			#########################################################
			# Now send out grat arp request for new IP address.	#
			#########################################################
			if($use_miitoollib) {
				::logmsg("Sending Builtin Gratuitous arp for $card:$cint") if defined(&::logmsg);
				$rc=miitoollib::send_arp("$card:$cint");
				if($rc ne "") {
					::logwarn("Gratuitous arp request failed (error below)") if defined(&::logwarn);
					::logwarn($rc) if defined(&::logwarn);
				}
			} elsif(-x "/opt/linuxha14/tools/send_arp") {
				$cmd="/opt/linuxha14/tools/send_arp $card:$cint";
				::logmsg("Sending Gratuitous arp: $cmd") if defined(&::logmsg);
				$r=`$cmd 2>&1`;
				if(defined($::APPLICATION_RC)) {
					$rc=$::APPLICATION_RC;
				} else {
					$rc=$?>>8;
				}
				if($rc) {
					::logwarn("Gratuitous arp request failed (error below)") if defined(&::logwarn);
					::logwarn($r) if defined(&::logwarn);
				}
			}
		} else {
			$cint=$ipinters->get_interface(ip=>$cip);
			#########################################################
			# If the IP address is already assigned then do nothing.#
			#########################################################
			if(defined($cint)) {
				next;
			}

			#########################################################
			# Only get here if the specified IP address is not	#
			# assigned.						#
			# IPv6 can assign multiple IP addresses to the base	#
			# card and does not use logical cards.			#
			#########################################################

			$cmd="ifconfig $card add $cip ";
			::logmsg("Configuring $cip: $cmd") if defined(&::logmsg);
			$cmd.=" 2>&1";
			$r=`$cmd`; chomp $r;
			if($?>>8) {
				return(0,"Unable to assign IP address $cip to $card");
			}

			#########################################################
			# Create the IP directory listing to help future	#
			# rebuilds.						#
			#########################################################

			if($ipfolder) {
				my $fd;
				open($fd,">/etc/cluster/.resources/ips/$appname-$net-$cip");
				close($fd) if defined($fd);
			}
		}
	}
	return(1);
}

#########################################################################
# unassign_ips(xml="x",appxml=>"y",network="z")				#
# Will unassign all IP addresses (ignoring if already unassigned) for 	#
# the specified application and network on the local host. Will return	#
# (1) - ok or (0,err,...) if error.					#
# Note: It is the responsibility of the call to get a lock on the	#
# 	NET resource before making use of this routine.			#
#	The code here is based on the similar code found in the		#
#	ipinterfaces module (that code will be removed).		#
#									#
# 1.1.x series								#
#									#
# If the ipfolder exists (/etc/cluster/.resource/ips) then any		#
# files for this application/network are removed when this routine	#
# is called.								#
#									#
#########################################################################

# XXX - alter the below for ipv6 too...

sub CLNET_unassign_network_ips2 {
my %args=@_;
my ($rc,@errs,$card,@nets);
my ($xml,$net,$f,$appxml,$ref,$chashref,$listref);
my ($ips,$cip,$ipinters,$cint,$netm);

	if(!exists($args{xml}) || !exists($args{appxml}) || !exists($args{network})) {
		return(0,"Missing one or more mandatory arguments (xml,appxml or network).");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};
	$net=$args{network};

	#################################################################
	# Remove /etc/cluster/.resources/ips/ entries if possible.	#
	#################################################################
	if(-d "/etc/cluster/.resources/ips") {
		my $appname=$appxml->{global}->{name};
		my @D=();
		my ($dfd,$cline);
		if(opendir($dfd,"/etc/cluster/.resources/ips")) {
			@D=readdir($dfd);
			close($dfd);
		}
		for (@D) {
			if(/^$appname-$net-/) {
				unlink "/etc/cluster/.resources/ips/$_";
			}
		}			
	}


	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# We now need to scan the list of networks looking for the one	#
	# that needs assigning.						#
	#################################################################

	$f=0;
	for (@$listref) {
		if(exists($_->{net}) && $_->{net} eq $net) {
			$f=1; $chashref=$_; last;
		}
	}
	if(!$f) {
		return(0,"Network $net not defined for application.");
	}
 
	#################################################################
	# Now check the net exists in the list of networks in the	#
	# cluster topology.						#
	#################################################################

	($rc,@nets)=CLNET_get_network_list2(node=>hostname,xml=>$xml);
	if(!$rc) {
		return(0,"Unable to get network list from cluster topology!");
	}

	if(!scalar(grep {/^$net$/} @nets)) {
		return(0,"Network $net not defined in cluster topology!");
	}

	#################################################################
	# Firstly we need to know which interface card we need to 	#
	# remove IP addresses from. 					#
	#################################################################
	($rc,@errs)=CLNET_check_one_ip2(node=>hostname,network=>$net,xml=>$xml);
	if(!$rc) {
		return(0,@errs);
	}
	$card=$errs[0];
	my $card6=$errs[1];
	#################################################################
	# Now we have the ethernet card, we need to generate the list	#
	# IP addresses to check ready for searching for them.		#
	#################################################################

	$ipinters=ipinterfaces->new;
	#################################################################
	# ips might include multiple IP addresses, so if so we		#
	# deal with that now...						#
	# Also rather than just N,N also handle N-N for ranges.		#
	# IPv6 addresses will have : in them, so use that to work out	#
	# how to deal with individual IP addresses.			#
	#################################################################
	{
		my ($_a,$_b);
		$ips=''; $netm={};
		if(exists($chashref->{ip})) {
			($_a,$_b)=_gen_ip_list($chashref->{ip});
			if(defined($_a)) {
				$ips=$_a;
				$netm={%{$_b}};
			}
		}
		if(exists($chashref->{ip6})) {
			($_a,$_b)=_gen_ip6_list($chashref->{ip6});
			if(defined($_a)) {
				if(length($ips)) {
					$ips.=",$_a";
					$netm={%{$netm},%{$_b}};
				} else {
					$ips=$_a;
					$netm={%{$_b}};
				}
			}
		}
	}
	for $cip (split(/,/,$ips)) {
		next if ! length($cip);
		my $cmd;
		$cint=$ipinters->get_interface(ip=>$cip);
		next if !defined($cint);
		if($cip =~ /:/) {
			$cmd="ifconfig $card6 del $cip ";
			::logmsg("Removing $cip: $cmd") if defined(&::logmsg);
			$cmd.=" 2>&1";
			my $r=`$cmd`; chomp $r;
			if($?>>8 && length($r)) {
				next if $r =~ /Cannot (un){0,1}assign requested/; # dodgy non-error
				return(0,"Unable to unassign IP address $cip from $cint - '$r'");
			}
			next;
		}

		$cmd="ifconfig $cint down ";
		::logmsg("Removing $cip: $cmd") if defined(&::logmsg);
		$cmd.=" 2>&1";
		my $r=`$cmd`; chomp $r;
		if($?>>8 && length($r)) {
			next if $r =~ /Cannot (un){0,1}assign requested/; # dodgy non-error
			return(0,"Unable to unassign IP address $cip from $cint - '$r'");
		}
	}
	return(1);
}

#########################################################################
# assign_ips(xml=>xml,appxml=>appxml)					#
# Use the assign_network_ips routine to assign all IP addresses 	#
# across all networks defined for the specified application on the	#
# local host.								#
# Returns(1) - ok, or (0,err,...) if errors.				#
#									#
# 1.1.x series								#
# It also passes through the rebuild=>1 if present to 			#
# CLNET_assign_network_ips2						#
#########################################################################

sub CLNET_assign_ips2 {
my %args=@_;
my ($xml,$appxml);
my ($ref,$chashref,$listref);
my ($r,@errs);

	if(!exists($args{xml}) || !exists($args{appxml})) {
		return(0,"Missing mandatory argument (requires xml,appxml)");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# For each hash reference allocate IP's for that network.	#
	#################################################################
	my %oargs=();
	if(exists($args{rebuild}) && defined($args{rebuild}) && $args{rebuild}) {
		$oargs{rebuild}=1;
	}
	for $chashref (@$listref) {
		if(exists($chashref->{net})) {
			($r,@errs)=CLNET_assign_network_ips2(%args,network=>$chashref->{net},%oargs);
			if(!$r) {
				return(0,"Errors whilst allocating IP addresses for network ".$chashref->{net},@errs);
			}
		}
	}
	return(1);
}

#########################################################################
# unassign_ips(xml=>xml,appxml=>appxml)					#
# Use the unassign_network_ips routine to unassign all IP addresses 	#
# across all networks defined for the specified application on the	#
# local host.								#
# Returns(1) - ok, or (0,err,...) if errors.				#
#########################################################################

sub CLNET_unassign_ips2 {
my %args=@_;
my ($xml,$appxml);
my ($ref,$chashref,$listref);
my ($r,@errs);

	if(!exists($args{xml}) || !exists($args{appxml})) {
		return(0,"Missing mandatory argument (requires xml,appxml)");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# For each hash reference allocate IP's for that network.	#
	#################################################################
	for $chashref (@$listref) {
		if(exists($chashref->{net})) {
			($r,@errs)=CLNET_unassign_network_ips2(%args,network=>$chashref->{net});
			if(!$r) {
				return(0,"Errors whilst unallocating IP addresses for network ".$chashref->{net},@errs);
			}
		}
	}
	return(1);
}

#########################################################################
# check_ping2(xml=>xml,appxml=>appxml,[pingtype=>"icmp",pingtimeout=>2])#
# Will return error/failure (0,err,...) if the required ping of the	#
# one or more primary IP addresses on the networks associated with this	#
# application are currently in use.					#
# Otherwise will return (1)						#
#########################################################################

sub CLNET_check_ping2 {
my %args=@_;
my ($xml,$appxml,$pingtype,$pingtimeout);
my ($p,$ref,$listref,$cnet);

	if(!exists($args{xml}) || !exists($args{appxml})) {
		return(-1,"Missing mandatory argument (requires xml,appxml)");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};
	$pingtype="icmp";
	$pingtimeout=1;
	$pingtype=$args{pingtype} if exists($args{pingtype});
	$pingtimeout=$args{pingtimeout} if exists($args{pingtimeout});

	#################################################################
	# Get a list of the nets for this application...		#
	#################################################################

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# We the list of networks, stopping at every network where	#
	# checking exists - all networks are checked here...		#
	#################################################################

	my $p6=undef;
	$p=Net::Ping->new(lc($pingtype),$pingtimeout);
	for $cnet (@$listref) {
		my ($netname,$ip);

		# Work for IP v6 via ip6 bit...
		$netname=$cnet->{net};
		if(exists($cnet->{ip})) {
			my ($nips,$nm)=_gen_ip_list($cnet->{ip});
			my @N=split(/,/,$nips);
			for my $cc (@N) {
				if($p->ping($cc)) {
					return(0,"IPv4 address $cc for network $netname already exists.");
				}
			}
		}
		if(exists($cnet->{ip6})) {
			my ($nips,$nm)=_gen_ip6_list($cnet->{ip6});
			my @N=split(/,/,$nips);
			for my $cc (@N) {
				my $i2=$cc;
				$i2 =~ s/\/.*//;
				my $pp=ping6($i2,$pingtimeout);
				if($pp==1) {
					return(0,"IPv6 address $cc for network $netname already exists.");
				}
			}
		}
	}
	return(1);
}

# Just check a list of IP addresses and return those that respond and those
# that do not in the specified timeout - which defaults to 0.25 seconds.

sub CLNET_check_ping_list2 {
my %args=@_;

	if(!exists($args{ips})) {
		return(-1,"Missing mandatory argument (requires ips).");
	}
	my @ips;
	if(ref($args{ips})) {
		@ips=@{$args{ips}};
	} else {
		@ips=split(/[,\s]+/,$args{ips});
	}
	my $timeout=0.25;
	if(exists($args{timeout}) && defined($args{timeout})) {
		$timeout=$args{timeout};
	}
	if($timeout>2.0) {
		$timeout=2.0;
	}

	my $ok=0; my $failed=0;
	my $p=Net::Ping->new('icmp',$timeout);
	for my $cip (@ips) {
		my ($netname,$ip);

		if($cip =~ /\./) {
			if($p->ping($cip)) {
				$ok++;
			} else {
				$failed++;
			}
		} else {
			my $pp=ping6($cip,$timeout);
			if($pp==1) {
				$ok++;
			} else {
				$failed++;
			}
		}
	}
	return($ok,$failed);
}

#########################################################################
# migrate_ips(xml=>$xml,network=>net,card=>newcard)			#
# This will migrate all IPs from the current interface defined for 	#
# the network to the specified card.					#
# It will return (1) or (0,error,...).					#
# The caller is responsible for getting/releasing a NET lock.		#
#########################################################################

sub CLNET_migrate_ips2 {
my %args=@_;
my ($net,$xml,$card);
my ($c_card,$cc,$ipinters);
my (@dcmd,@acmd,@alist);

	@alist=();
	if(!exists($args{xml}) || !exists($args{network}) || !exists($args{card})) {
		return(0,"Missing mandatory argument (requires xml,network,card)");
	}
	$xml=$args{xml};
	$net=$args{network};
	$card=$args{card};

	my ($res,$acard,$acard6,$aip,$aip6)=CLNET_check_one_ip2(network=>$net,xml=>$xml);

	if(!$res) {
		return(0,$acard);
	}

	my $iptype=4;
	if(exists($xml->{global}->{iptype})) {
		$iptype=$xml->{global}->{iptype};
	}
	$ipinters=new ipinterfaces;
	$c_card=$ipinters->get_details2(interface=>"$acard:0");
	# Deconfigure the IPv4 address - if any ...
	@dcmd=(); @acmd=();
	if(exists($c_card->{ip4}) && @{$c_card->{ip4}}) {
		push @dcmd,"ifconfig $acard inet 0.0.0.0 down 2>&1; ";
	}
	if(exists($c_card->{ip6}) && @{$c_card->{ip6}}) {
		for my $cc (@{$c_card->{ip6}}) {
			push @dcmd,"ifconfig $acard del $cc->[0]/$cc->[1] 2>&1; ";
		}
	}
	# Now we move the IPv4 addresses to the new card...
	if(exists($c_card->{ip4}) && @{$c_card->{ip4}}) {
		my $log=0;
		for my $cc (@{$c_card->{ip4}}) {
			if($log>0) {
				push @acmd,"ifconfig $card:$log inet $cc->[0]/$cc->[1] broadcast $cc->[2] up 2>&1;";
			} else {
				push @acmd,"ifconfig $card inet $cc->[0]/$cc->[1] broadcast $cc->[2] up 2>&1;";
			}
			push @alist,"$card:$log";
			$log++;
		}
	}
	# Now we move the IPv6 addresses to the new card...
	if(exists($c_card->{ip6}) && @{$c_card->{ip6}}) {
		for my $cc (@{$c_card->{ip6}}) {
			push @acmd,"ifconfig $card add $cc->[0]/$cc->[1] up 2>&1;";
		}
	}

	my @routes=();
	if(exists($c_card->{ip4}) && @{$c_card->{ip4}}) {
		# Get any ipv4 routing ...
		@routes=$ipinters->get_routes(interface=>$acard);
	}
	#################################################################
	# Delete all ipv4/ipv6 addresses associated with the old	#
	# interface.							#
	#################################################################

	for my $cc (@dcmd) {
		::logmsg("Running [ip deletes]: $cc");
		system($cc);
	}
	for my $cc (@acmd) {
		::logmsg("Running [ip adds]   : $cc");
		system($cc);
	}
	if(exists($c_card->{ip4}) && @{$c_card->{ip4}}) {
		if(defined(defined(&miitoollib::send_arp))) {
			miitoollib::send_arp($_) for (@alist);
		} elsif(-x "/opt/linuxha14/tools/send_arp") {
			`/opt/linuxha14/tools/send_arp $_ 2>&1` for (@alist);
		}
		if(@routes) {
			$ipinters->set_routes(interface=>$card,routes=>\@routes);
		}
	}
	return(1);
}

sub CLNET_map_ip_to_network2 {
my %args=@_;
my ($ip,$fd,@F);
	if(!exists($args{ip})) {
		return(undef,"Missing mandatory argument (requires ip)");
	}
	if(! -f "/etc/cluster/.networks") {
		return ("?unknown?","/etc/cluster/.networks file does not exist!");
	}
	$ip=$args{ip};
	if($ip =~ /:/ && substr($ip,0,1) ne '[') {
		$ip="[$ip]";
	}
	open($fd,"/etc/cluster/.networks") or
		return("?unknown?","Unable to open /etc/cluster/.networks file.");
	while(<$fd>) {
		chomp;
		@F=split(/:/,$_);
		if($F[3] eq $ip) {
			close($fd);
			return($F[2],undef);
		}
	}
	close($fd);
	return("?unknown?","Specified IP address not found in /etc/cluster/.networks file!");
}

1;

